home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEBITINS.BAS < prev    next >
BASIC Source File  |  1987-01-11  |  3KB  |  110 lines
  1. rem $linesize:132
  2. rem $title:'Application Engineer Standard Routines'
  3. rem $subtitle:'Insert a new key into the index'
  4.  
  5. '                Include the COMMON values
  6. rem $include:'AESHARED.BAS'            
  7.     
  8. sub bit.ins(fl%,ky$,mrec%,success%) static
  9.  
  10. '  insert a new key into the index
  11. '  use the new method, access the deletions stack.
  12.  
  13.         success%=0           ' no success yet
  14.         if mrec%<1 then
  15.             success%=-1%
  16.         end if
  17.         if len(ky$)<1 then
  18.             success%=-2%
  19.         end if
  20.  
  21. '  a check is needed to see if the index has grown to it's maximum
  22. '  size. a note here on how to make this index handle records greater
  23. '  than 32767. all the cvi and mki$ routines should be changed to cvs
  24. '  and mks$. also, all refernces to % (where the % is a pointer value
  25. '  in the index) should be changed to ! . the record size will increase
  26. '  as well, because the pointer fields change in length from 2 bytes to
  27. '  4 bytes.
  28.  
  29.         if xh%(fl%,2)=32767 then
  30.             success%=-3%
  31.         end if
  32.  
  33.         if success%<0% then
  34.             exit sub
  35.         end if
  36.  
  37. '  if the length of ky$ is less than the length of the max size for
  38. '  the key, then ky$ will be padded with blanks
  39.  
  40.         if len(ky$)<xh%(fl%,1) then ky$=ky$+string$(xh%(fl%,1)-len(ky$),32)
  41.         rrec%=1
  42.         loop%=0%
  43.  
  44.         while loop%=0%
  45.             prrec%=rrec%                           ' hold the recnum for eval
  46.             get #fl%,rrec%
  47.             if cvi(xk$(fl%,5))=0 then
  48.                 goto place                          ' this is where the key goes
  49.             end if
  50.             if ky$<xk$(fl%,1) then
  51.                 side%=2%
  52.             else
  53.                 side%=3%
  54.             end if
  55.             rrec%=cvi(xk$(fl%,side%))
  56.             if rrec%=0 then
  57.                 loop%=1%                          ' this is where the key goes
  58.             end if
  59.         wend
  60. place:
  61.         if xh%(fl%,4%) then
  62.             gf%=4%
  63.         else
  64.             gf%=3%
  65.         end if
  66.  
  67.         get #fl%,xh%(fl%,gf%)
  68.         nrec%=cvi(xk$(fl%,6%))
  69.         lset xk$(fl%,1)=ky$
  70.  
  71.         if xh%(fl%,3)<>1 then
  72.             goto nfirst                         ' not the first record
  73.         end if
  74.         lset xk$(fl%,4)=mki$(0)                ' initialize
  75.         goto other
  76. nfirst:
  77.         lset xk$(fl%,4)=mki$(prrec%)
  78. other:
  79.         lset xk$(fl%,3)=mki$(0)
  80.         lset xk$(fl%,2)=mki$(0)
  81.         lset xk$(fl%,5)=mki$(mrec%)
  82.         lset xk$(fl%,6)=mki$(0)                ' next deleted
  83.         put #fl%,xh%(fl%,gf%)
  84.  
  85.         if gf%=3% then
  86.             if xh%(fl%,3)=1 then
  87.                 goto increment
  88.             end if
  89.         end if
  90.  
  91.         get #fl%,prrec%
  92.         lset xk$(fl%,side%)=mki$(xh%(fl%,gf%))
  93.         put #fl%,prrec%
  94.  
  95. increment:
  96.         if gf%=4% then
  97.             xh%(fl%,4%)=nrec%
  98.         else
  99.             xh%(fl%,4%)=0%
  100.             xh%(fl%,3)=xh%(fl%,3)+1
  101.             lset xk$(fl%,1%)=string$(xh%(fl%,1%),0%)
  102.             for j%=2% to 6%
  103.                 lset xk$(fl%,j%)=mki$(0%)
  104.             next j%
  105.             put #fl%,xh%(fl%,3%)
  106.         end if
  107.         xh%(fl%,2)=xh%(fl%,2)+1
  108.         success%=1
  109.     end sub
  110.